home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / RTSEC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  808b  |  35 lines
  1. FUNCTION rtsec(x1,x2,xacc: real): real;
  2. (* Programs using routine RTSEC must externally define a
  3. function fx(x:real):real which is to be analyzed for roots. *)
  4. LABEL 99;
  5. CONST
  6.    maxit=30;
  7. VAR
  8.    dx,f,fl,swap,xl,rts: real;
  9.    j: integer;
  10. BEGIN
  11.    fl := fx(x1);
  12.    f := fx(x2);
  13.    IF (abs(fl) < abs(f)) THEN BEGIN
  14.       rts := x1;
  15.       xl := x2;
  16.       swap := fl;
  17.       fl := f;
  18.       f := swap
  19.    END ELSE BEGIN
  20.       xl := x1;
  21.       rts := x2
  22.    END;
  23.    FOR j := 1 TO maxit DO BEGIN
  24.       dx := (xl-rts)*f/(f-fl);
  25.       xl := rts;
  26.       fl := f;
  27.       rts := rts+dx;
  28.       f := fx(rts);
  29.       IF ((abs(dx) < xacc) OR (f = 0.0)) THEN GOTO 99
  30.    END;
  31.    writeln('pause in routine RTSEC');
  32.    writeln('maximum number of iterations exceeded'); readln;
  33. 99:   rtsec := rts
  34. END;
  35.